home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / ENTRY.SWG / 0015_Generic Data Entry.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-24  |  27KB  |  803 lines

  1.  
  2. {-----------------------------------------------------------------------------}
  3. {                                                                             }
  4. { SAISIE.PAS - (c) Raphaël VANNEY, 1993                                       }
  5. {                                                                             }
  6. { Generic data entry unit.                                                    }
  7. { Langage : Borland Pascal 7                                                  }
  8. {                                                                             }
  9. { This unit intends to provide a tool for data entry from a Pascal program,   }
  10. { in a more fancy fashion that what ReadLn allows for.                        }
  11. {                                                                             }
  12. { I wrote it not because I felt like reinventing the wheel, but rather        }
  13. { because I needed something that was not available for the OS/2 patch of     }
  14. { Borland Pascal.                                                             }
  15. {                                                                             }
  16. { As a result, this unit will compile and run DOS, DPMI and OS/2 programs.    }
  17. {                                                                             }
  18. { Note : depending on the version of the OS/2 patch you use, this unit        }
  19. {        may not work properly (problem with extended keys).                  }
  20. {                                                                             }
  21. {-----------------------------------------------------------------------------}
  22. {$b-,x+}
  23.  
  24. {$IfDef OS2}
  25.      {$c Moveable Discardable DemandLoad}
  26. {$EndIf}
  27.  
  28. Unit Saisie ;
  29.  
  30. Interface
  31.  
  32. Uses Objects ;
  33.  
  34. Const
  35.      { A few key codes, as returned by LitTouche }
  36.      kbTab          = 9 ;
  37.      kbEntree       = 13 ;         { enter }
  38.      kbRetour       = 8 ;          { backspace }
  39.      kbCtrlEntree   = 10 ;         { ctrl-enter }
  40.      kbEchap        = 27 ;         { escape }
  41.      kbHaut         = 18432 ;      { up }
  42.      kbBas          = 20480 ;      { down }
  43.      kbDroite       = 19712 ;      { right }
  44.      kbGauche       = 19200 ;      { left }
  45.      kbPageHaut     = 18688 ;      { PgUp }
  46.      kbPageBas      = 20736 ;      { PgDn }
  47.      kbFin          = 20224 ;      { end }
  48.      kbDebut        = 18176 ;      { home }
  49.      kbIns          = 20992 ;
  50.      kbSuppr        = 21248 ;      { del }
  51.  
  52.      kbCtrlD        = 4 ;
  53.      kbCtrlT        = 20 ;
  54.      kbCtrlY        = 25 ;
  55.  
  56.      kbCtrlDroite   = 29696 ;      { ctrl-right }
  57.      kbCtrlGauche   = 29440 ;      { ctrl-left }
  58.  
  59.      Caracteres     : Set Of Char = ['a'..'z', 'A'..'Z', #128..#165] ;
  60.  
  61.  
  62. Type { TListeChaines is an unsorted collection of PString's                }
  63.      TListeChaines =
  64.      Object(TCollection)
  65.           Procedure      FreeItem(Item : Pointer) ; Virtual ;
  66.      End ;
  67.      PListeChaines = ^TListeChaines ;
  68.  
  69.      { TChampSaisie is the basic, ancestor data entry field                }
  70.      TChampSaisie =
  71.      Object(TObject)
  72.           Contenu        : String ;     { content during keyboard input    }
  73.           x, y,                         { screen coordinates               }
  74.           Largeur,                      { on-screen width of field         }
  75.           Taille,                       { size of the field                }
  76.           AttrActif,                    { active field colors              }
  77.           AttrPassif     : Byte ;       { passive field colors             }
  78.           Variable       : Pointer ;    { pointer to variable to fill      }
  79.           EffaceAuto     : Boolean ;    { True if automatic clearing       }
  80.  
  81.           Constructor    Init(     _x, _y         : Integer ;
  82.                                    _Largeur       : Integer ;
  83.                                    _Taille        : Integer ;
  84.                                    _AttrActif,
  85.                                    _AttrPassif    : Integer ;
  86.                                    Var _Variable) ;
  87.  
  88.           { Dessine draws the entry field on screen. Decalage is an
  89.             optional shifting (if content is wider than screen field)      }
  90.           Procedure      Dessine(  Actif     : Boolean ;
  91.                                    Decalage  : Integer) ; Virtual ;
  92.  
  93.           { Runs the data entry. Returns the code of the key used to exit. }
  94.           Function       Execute : Word ; Virtual ;
  95.  
  96.           { Reads a key from keyboard. May be redefined by child objects,
  97.             for instance to handle the mouse.                              }
  98.           Function       LitTouche : Word ; Virtual ;
  99.  
  100.           { Checks whether or not a key is valid or not, given cursor pos.
  101.             Should be redefined for numeric fields, etc...                 }
  102.           Function       ToucheValide(  Position  : Integer ;
  103.                                         Touche    : Word) : Boolean ; Virtual ;
  104.  
  105.           { Handles the key. Returns True if the key was accepted.         }
  106.           Function       GereTouche(Var Position  : Integer ;
  107.                                     Var Touche    : Word) : Boolean ; Virtual ;
  108.  
  109.           { Reads the content of the user variable (pointed to by
  110.             Variable) to Contenu.                                          }
  111.           Procedure      LitResultat ; Virtual ;
  112.  
  113.           { Moves Contenu to the user variable.                            }
  114.           Procedure      EcritResultat ; Virtual ;
  115.  
  116.           { Checks whether Contenu's (what the user typed!) is valid.      }
  117.           Function       ContenuValide : Boolean ; Virtual ;
  118.      End ;
  119.      PChampSaisie   = ^TChampSaisie ;
  120.  
  121.      { The next objects are specialized childrens of TChampSaisie. Now,
  122.        what is OOP for ? ;-)                                               }
  123.  
  124.      { TChampLongint specializes in handling LongInt input.                }
  125.      TChampLongInt  =
  126.      Object(TChampSaisie)
  127.           Function       ToucheValide(  Position  : Integer ;
  128.                                         Touche    : Word) : Boolean ; Virtual ;
  129.           Procedure      LitResultat ; Virtual ;
  130.           Procedure      EcritResultat ; Virtual ;
  131.           Function       ContenuValide : Boolean ; Virtual ;
  132.      End ;
  133.      PChampLongInt  = ^TChampLongInt ;
  134.  
  135.      { TChampOctet is done to handle Byte input.                           }
  136.      TChampOctet    =
  137.      Object(TChampLongInt)
  138.           Mini,
  139.           Maxi      : Byte ;
  140.  
  141.           Constructor    Init(     _x, _y         : Integer ;
  142.                                    _Largeur       : Integer ;
  143.                                    _Taille        : Integer ;
  144.                                    _AttrActif,
  145.                                    _AttrPassif    : Integer ;
  146.                                    _Mini, _Maxi   : Byte ;
  147.                                    Var _Variable  : Byte) ;
  148.           Procedure      LitResultat ; Virtual ;
  149.           Procedure      EcritResultat ; Virtual ;
  150.           Function       ContenuValide : Boolean ; Virtual ;
  151.      End ;
  152.      PChampOctet    = ^TChampOctet ;
  153.  
  154.      { TChampMajuscules will uppercase what the user types in.             }
  155.      TChampMajuscules =
  156.      Object(TChampSaisie)
  157.           Function       GereTouche(Var Position  : Integer ;
  158.                                     Var Touche    : Word) : Boolean ; Virtual ;
  159.      End ;
  160.      PChampMajuscules = ^TChampMajuscules ;
  161.  
  162.      { TChampChoixListe will let the user make a choice within a defined
  163.        list. See the 'Sex' field in TEST.PAS.                              }
  164.      TChampChoixListe =
  165.      Object(TChampSaisie)
  166.           Liste          : PListeChaines ;   { choices list                }
  167.           Courant        : Integer ;         { current choice              }
  168.  
  169.           { _Variable contains (and will be so updated) the index of the
  170.             selected entry in the _Liste list of choices.                  }
  171.           Constructor    Init(     _x, _y         : Integer ;
  172.                                    _Largeur       : Integer ;
  173.                                    _AttrActif,
  174.                                    _AttrPassif    : Integer ;
  175.                                    _Liste         : PListeChaines ;
  176.                                    Var _Variable  : Integer) ;
  177.           Function       ToucheValide(  Position  : Integer ;
  178.                                         Touche    : Word) : Boolean ; Virtual ;
  179.           Function       GereTouche(Var Position  : Integer ;
  180.                                     Var Touche    : Word) : Boolean ; Virtual ;
  181.           Procedure      LitResultat ; Virtual ;
  182.           Procedure      EcritResultat ; Virtual ;
  183.  
  184.           Private
  185.  
  186.           Procedure      MetAJourContenu ;
  187.      End ;
  188.      PChampChoixListe = ^TChampChoixListe ;
  189.  
  190.      { TChampPChar will let you input a ASCIIZ string.                     }
  191.      TChampPChar    =
  192.      Object(TChampSaisie)
  193.           Procedure      LitResultat ; Virtual ;
  194.           Procedure      EcritResultat ; Virtual ;
  195.      End ;
  196.      PChampPChar    = ^TChampPChar ;
  197.  
  198.      { TChampBoolean handles Boolean fields input.                         }
  199.      TChampBooleen  =
  200.      Object(TChampSaisie)
  201.           Constructor    Init(     _x, _y         : Integer ;
  202.                                    _AttrActif,
  203.                                    _AttrPassif    : Integer ;
  204.                                    Var _Variable  : Boolean) ;
  205.           Function       ToucheValide(  Position  : Integer ;
  206.                                         Touche    : Word) : Boolean ; Virtual ;
  207.           Function       GereTouche(Var Position  : Integer ;
  208.                                     Var Touche    : Word) : Boolean ; Virtual ;
  209.           Procedure      LitResultat ; Virtual ;
  210.           Procedure      EcritResultat ; Virtual ;
  211.      End ;
  212.      PChampBooleen  = ^TChampBooleen ;
  213.  
  214.      { TGroupeSaisie is a collection of TChampSaisie. The Execute method
  215.        will handle cycling through entry fields, etc...                    }
  216.      TGroupeSaisie  =
  217.      Object(TCollection)
  218.           Function  Execute : Word ;
  219.      End ;
  220.      PGroupeSaisie  = ^TGroupeSaisie ;
  221.  
  222. { Utilities                                                                }
  223. Function Complete(St : OpenString ; Len : Integer) : String ;
  224. Function LitClavier : Integer ;
  225.  
  226. {--------------------------------------------------------------------------}
  227. {--------------------------------------------------------------------------}
  228.  
  229. Implementation
  230.  
  231. Uses DOS,
  232.      Strings,
  233. {$IfDef OS2}
  234.      OS2Subs,
  235. {$EndIf}
  236.      CRT ;
  237.  
  238. {-----------------------------------------------------------------------------}
  239.  
  240. Function LitClavier : Integer ;
  241. Var  t    : Word ;
  242. Begin
  243.      t:=Ord(ReadKey) ;
  244.      If t=0 Then t:=Ord(ReadKey) ShL 8 ;
  245.      LitClavier:=t ;
  246. End ;
  247.  
  248. Function Complete(St : OpenString ; Len : Integer) : String ;
  249. Var  i    : Integer ;
  250. Begin
  251.      For i:=Length(St)+1 To Len Do St[i]:=' ' ;
  252.      St[0]:=Chr(Len) ;
  253.      Complete:=St ;
  254. End ;
  255.  
  256. Constructor TChampSaisie.Init ;
  257. Begin
  258.      x:=_x ;
  259.      y:=_y ;
  260.      Largeur:=_Largeur ;
  261.      If (Largeur<0) Or (Largeur>80) Then Fail ;
  262.      Taille:=_Taille ;
  263.      AttrActif:=_AttrActif ;
  264.      AttrPassif:=_AttrPassif ;
  265.      Variable:=Addr(_Variable) ;
  266.      EffaceAuto:=True ;
  267.  
  268.      LitResultat ;
  269.      If Length(Contenu)>Taille Then
  270.           Contenu:=Copy(Contenu, 1, Taille) ;
  271. End ;
  272.  
  273. Procedure TChampSaisie.Dessine ;
  274. Var  St   : String ;
  275. Begin
  276.      If Actif Then TextAttr:=AttrActif
  277.               Else TextAttr:=AttrPassif ;
  278.      St:=Copy(Contenu, Decalage, Largeur) ;
  279.      If Length(St)<Largeur Then St:=Complete(St, Largeur) ;
  280. {$IfDef OS2}
  281.      VioWrtCharStrAtt(   @St[1], Length(St),
  282.                          y+Hi(WindMin)-1, x+Lo(WindMin)-1,
  283.                          TextAttr, 0) ;
  284. {$Else}
  285.      GoToXY(x, y) ;
  286.      Write(St) ;
  287. {$EndIf}
  288. End ;
  289.  
  290. Function TChampSaisie.Execute ;
  291. Var  Touche    : Word ;
  292.      Position  : Integer ;
  293.      Decalage  : Integer ;
  294.      Termine   : Boolean ;
  295.      Premiere  : Boolean ;
  296. Begin
  297.      Decalage:=1 ;
  298.      Position:=1 ;
  299.      Termine:=False ;
  300.      Premiere:=True ;
  301.  
  302.      Repeat
  303.           Dessine(True, Decalage) ;
  304.           GoToXY(x-Decalage+Position, y) ;
  305.           Touche:=LitTouche ;
  306.           If EffaceAuto Then
  307.           If Premiere Then
  308.           If (Touche>31) And (Touche<256) Then
  309.           If ToucheValide(Position, Touche) Then Contenu:='' ;
  310.           Premiere:=False ;
  311.           If Not GereTouche(Position, Touche) Then
  312.           { A-t-on terminé ? }
  313.           If (Touche<32) Or (Touche>255) Then Termine:=True ;
  314.           { Adaptons Decalage à Position }
  315.           If Position<Decalage Then Decalage:=Position ;
  316.           If Position>=(Decalage+Largeur) Then Decalage:=Position-Largeur+1 ;
  317.  
  318.           If Termine Then
  319.           Begin
  320.                Termine:=ContenuValide ;
  321.                If Not Termine Then
  322.                Begin
  323. {$IfDef OS2}
  324.                     PlaySound(300, 200) ;
  325. {$Else}
  326.                     Sound(300) ;
  327.                     Delay(200) ;
  328.                     NoSound ;
  329. {$EndIf}
  330.                End ;
  331.           End ;
  332.      Until Termine ;
  333.  
  334.      If Touche<>kbEchap Then EcritResultat
  335.                         Else LitResultat ;
  336.      Dessine(False, 1) ;
  337.      Execute:=Touche ;
  338. End ;
  339.  
  340. Function TChampSaisie.LitTouche ;
  341. Begin
  342.      LitTouche:=LitClavier ;
  343. End ;
  344.  
  345. Function TChampSaisie.ToucheValide ;
  346. Begin
  347.      ToucheValide:=True ;
  348. End ;
  349.  
  350. Function TChampSaisie.ContenuValide ;
  351. Begin
  352.      ContenuValide:=True ;
  353. End ;
  354.  
  355. Function TChampSaisie.GereTouche ;
  356. Begin
  357.      GereTouche:=True ;
  358.      If ToucheValide(Position, Touche) Then
  359.      Begin
  360.           Case Touche Of
  361.                32..255   :
  362.                Begin
  363.                     Insert(Chr(Touche), Contenu, Position) ;
  364.                     If Length(Contenu)>Taille Then Dec(Contenu[0]) ;
  365.                     If Position<Taille Then Inc(Position) ;
  366.                End ;
  367.                kbCtrlD,
  368.                kbDroite  :
  369.                Begin
  370.                     If Position<=Length(Contenu) Then Inc(Position) ;
  371.                     If Position>Taille Then Dec(Position) ;
  372.                End ;
  373.                kbGauche  :
  374.                Begin
  375.                     If Position>1 Then Dec(Position) ;
  376.                End ;
  377.                kbRetour  :
  378.                Begin
  379.                     If Position>1 Then
  380.                     Begin
  381.                          Dec(Position) ;
  382.                          Delete(Contenu, Position, 1) ;
  383.                     End ;
  384.                End ;
  385.                kbSuppr   :
  386.                Begin
  387.                     If Position<=Length(Contenu) Then
  388.                     Begin
  389.                          Delete(Contenu, Position, 1) ;
  390.                     End ;
  391.                End ;
  392.                kbFin     : Position:=Length(Contenu)+1 ;
  393.                kbDebut   : Position:=1 ;
  394.                kbCtrlY   :
  395.                Begin
  396.                     Contenu:='' ;
  397.                     Position:=1 ;
  398.                End ;
  399.                kbCtrlT   :
  400.                Begin
  401.                     While (Position<Length(Contenu)) And
  402.                           (Contenu[Position] In Caracteres) Do
  403.                          Delete(Contenu, Position, 1) ;
  404.                     If Position<=Length(Contenu) Then
  405.                          Delete(Contenu, Position, 1) ;
  406.                End ;
  407.                kbCtrlGauche :
  408.                Begin
  409.                     If Position>1 Then Dec(Position) ;
  410.                     While (Position>1) And
  411.                           (Contenu[Position-1] In Caracteres) Do Dec(Position) ;
  412.                End ;
  413.                kbCtrlDroite :
  414.                Begin
  415.                     While (Position<Length(Contenu)) And
  416.                           (Contenu[Position] In Caracteres) Do Inc(Position) ;
  417.                     If Position<=Length(Contenu) Then Inc(Position) ;
  418.                     If Position>Taille Then Dec(Position) ;
  419.                End ;
  420.                Else GereTouche:=False ;
  421.           End ;
  422.      End Else
  423.      Begin
  424. {$IfDef OS2}
  425.           PlaySound(1000, 100) ;
  426. {$Else}
  427.           Sound(1000) ;
  428.           Delay(100) ;
  429.           NoSound ;
  430. {$EndIf}
  431.      End ;
  432. End ;
  433.  
  434. Procedure TChampSaisie.LitResultat ;
  435. Begin
  436.      Move(Variable^, Contenu, Taille+1) ;
  437. End ;
  438.  
  439. Procedure TChampSaisie.EcritResultat ;
  440. Begin
  441.      Move(Contenu, Variable^, Length(Contenu)+1) ;
  442. End ;
  443.  
  444. {-------------------------------------- TGroupeSaisie ------------------------}
  445.  
  446. Function TGroupeSaisie.Execute ;
  447.  
  448.      Procedure Affiche(Champ : PChampSaisie) ; Far ;
  449.      Begin
  450.           Champ^.Dessine(False, 1) ;
  451.      End ;
  452.  
  453. Var  Touche    : Word ;
  454.      Courant   : Integer ;
  455.      Termine   : Boolean ;
  456.  
  457. Begin
  458.      ForEach(@Affiche) ;
  459.  
  460.      Termine:=Count=0 ;
  461.      Courant:=0 ;
  462.      Touche:=kbEchap ;
  463.  
  464.      Repeat
  465.           Touche:=PChampSaisie(At(Courant))^.Execute ;
  466.           Case Touche Of
  467.                kbHaut    :
  468.                Begin
  469.                     Dec(Courant) ;
  470.                     If Courant<0 Then Courant:=Pred(Count) ;
  471.                End ;
  472.                kbEntree,
  473.                kbTab,
  474.                kbBas     :
  475.                Begin
  476.                     Inc(Courant) ;
  477.                     If Courant>=Count Then Courant:=0 ;
  478.                End ;
  479.                kbPageHaut,
  480.                kbPageBas,
  481.                kbEchap,
  482.                kbCtrlEntree :
  483.                Begin
  484.                     Termine:=True ;
  485.                End ;
  486.           End ;
  487.      Until Termine ;
  488.  
  489.      Execute:=Touche ;
  490. End ;
  491.  
  492. {-------------------------------------- TChampLongInt ------------------------}
  493.  
  494. Function TChampLongInt.ToucheValide ;
  495. Begin
  496.      ToucheValide:=(Touche<32) Or (Touche>255) Or
  497.                    ((Touche>=Ord('0')) And (Touche<=Ord('9'))) ;
  498. End ;
  499.  
  500. Procedure TChampLongInt.LitResultat ;
  501. Type PLongInt  = ^LongInt ;
  502. 3Begin
  503.      Str(PLongInt(Variable)^, Contenu) ;
  504. End ;
  505.  
  506. Procedure TChampLongInt.EcritResultat ;
  507. Type PLongInt  = ^LongInt ;
  508. Var  Err  : Integer ;
  509. Begin
  510.      Val(Contenu, PLongInt(Variable)^, Err) ;
  511. End ;
  512.  
  513. Function TChampLongInt.ContenuValide ;
  514. Type PLongInt  = ^LongInt ;
  515. Var  Err  : Integer ;
  516. Begin
  517.      Val(Contenu, PLongInt(Variable)^, Err) ;
  518.      ContenuValide:=Err=0 ;
  519. End ;
  520.  
  521. {-------------------------------------- TChampOctet --------------------------}
  522.  
  523. Constructor TChampOctet.Init ;
  524. Begin
  525.      Mini:=_Mini ;
  526.      Maxi:=_Maxi ;
  527.      If Not Inherited Init(_x, _y, _Largeur, _Largeur, _AttrActif,
  528.                            _AttrPassif, _Variable) Then Fail ;
  529.      If Not ContenuValide Then
  530.      Begin
  531.           _Variable:=Mini ;
  532.           LitResultat ;
  533.      End ;
  534. End ;
  535.  
  536. Procedure TChampOctet.LitResultat ;
  537. Type PByte     = ^Byte ;
  538. Begin
  539.      Str(PByte(Variable)^, Contenu) ;
  540. End ;
  541.  
  542. Procedure TChampOctet.EcritResultat ;
  543. Type PByte  = ^Byte ;
  544. Var  Err  : Integer ;
  545. Begin
  546.      Val(Contenu, PByte(Variable)^, Err) ;
  547. End ;
  548.  
  549. Function TChampOctet.ContenuValide ;
  550. Type PByte     = ^Byte ;
  551. Var  Err  : Integer ;
  552. Begin
  553.      Val(Contenu, PByte(Variable)^, Err) ;
  554.      ContenuValide:=(Err=0) And
  555.                     (PByte(Variable)^>=Mini) And
  556.                     (PByte(Variable)^<=Maxi) ;
  557. End ;
  558.  
  559. {-------------------------------------- TChampMajuscules ------------------}
  560. { This should give you ideas if you need input masks...                    }
  561.  
  562. Function TChampMajuscules.GereTouche ;
  563. Begin
  564.      If (Touche>=Ord('a')) And (Touche<=Ord('z')) Then Dec(Touche, 32) ;
  565.      GereTouche:=Inherited GereTouche(Position, Touche) ;
  566. End ;
  567.  
  568. {-------------------------------------- TListeChaines ------------------------}
  569.  
  570. Procedure TListeChaines.FreeItem ;
  571. Begin
  572.      If Item<>Nil Then DisposeStr(PString(Item)) ;
  573. End ;
  574.  
  575. {-------------------------------------- TChampChoixListe ---------------------}
  576.  
  577. Constructor TChampChoixListe.Init ;
  578. Begin
  579.      Liste:=_Liste ;
  580.      If Not Inherited Init(_x, _y, _Largeur, _Largeur, _AttrActif,
  581.                            _AttrPassif, _Variable) Then Fail ;
  582. End ;
  583.  
  584. Procedure TChampChoixListe.LitResultat ;
  585. Type PInteger = ^Integer ;
  586. Begin
  587.      Courant:=PInteger(Variable)^ ;
  588.      If (Courant<0) Or
  589.         (Courant>=Liste^.Count) Then Courant:=0 ;
  590.      MetAJourContenu ;
  591. End ;
  592.  
  593. Procedure TChampChoixListe.EcritResultat ;
  594. Type PInteger  = ^Integer ;
  595. Begin
  596.      PInteger(Variable)^:=Courant ;
  597. End ;
  598.  
  599. Function TChampChoixListe.ToucheValide ;
  600. Begin
  601.      ToucheValide:=(Touche<32) Or (Touche>255) ;
  602. End ;
  603.  
  604. Function TChampChoixListe.GereTouche ;
  605. Begin
  606.      GereTouche:=True ;
  607.      If ToucheValide(Position, Touche) Then
  608.      Begin
  609.           Case Touche Of
  610.                kbDroite       :
  611.                Begin
  612.                     Inc(Courant) ;
  613.                     If Courant>=Liste^.Count Then Courant:=0 ;
  614.                     MetAJourContenu ;
  615.                End ;
  616.                kbGauche       :
  617.                Begin
  618.                     Dec(Courant) ;
  619.                     If Courant<0 Then Courant:=Pred(Liste^.Count) ;
  620.                     MetAJourContenu ;
  621.                End ;
  622.                Else GereTouche:=False ;
  623.           End ;
  624.      End Else
  625.      Begin
  626. {$IfDef OS2}
  627.           PlaySound(1000, 100) ;
  628. {$Else}
  629.           Sound(1000) ;
  630.           Delay(100) ;
  631.           NoSound ;
  632. {$EndIf}
  633.      End ;
  634. End ;
  635.  
  636. Procedure TChampChoixListe.MetAJourContenu ;
  637. Var  Tmp  : String[80] ;
  638. Begin
  639.      If Liste^.At(Courant)=Nil
  640.      Then Tmp:=''
  641.      Else Tmp:=Copy(PString(Liste^.At(Courant))^, 1, Largeur-2) ;
  642.      Contenu:=#17+Complete(Tmp, Largeur-2)+#16 ;
  643. End ;
  644.  
  645. {-------------------------------------- TChampPChar --------------------------}
  646.  
  647. Procedure TChampPChar.LitResultat ;
  648. Begin
  649.      Contenu:=StrPas(Variable) ;
  650. End ;
  651.  
  652. Procedure TChampPChar.EcritResultat ;
  653. Begin
  654.      StrPCopy(Variable, Contenu) ;
  655. End ;
  656.  
  657. {-------------------------------------- TChampBooleen ------------------------}
  658.  
  659. Constructor TChampBooleen.Init ;
  660. Begin
  661.      If Not Inherited Init(_x, _y, 3, 3, _AttrActif,
  662.                            _AttrPassif, _Variable) Then Fail ;
  663.      EffaceAuto:=False ;
  664. End ;
  665.  
  666. Function TChampBooleen.ToucheValide ;
  667. Begin
  668.      ToucheValide:=(Touche<=32) Or (Touche>255) ;
  669. End ;
  670.  
  671. Function TChampBooleen.GereTouche ;
  672. Begin
  673.      If (Touche=32) Or
  674.         (Touche=kbDroite) Or
  675.         (Touche=kbGauche) Then
  676.      Begin
  677.           GereTouche:=True ;
  678.           If Contenu[2]=' ' Then Contenu[2]:='■'
  679.                             Else Contenu[2]:=' ' ;
  680.      End Else
  681.      Begin
  682.           GereTouche:=Inherited GereTouche(Position, Touche) ;
  683.      End ;
  684. End ;
  685.  
  686. Procedure TChampBooleen.LitResultat ;
  687. Type PBoolean  = ^Boolean ;
  688. Begin
  689.      If PBoolean(Variable)^ Then Contenu:='[■]'
  690.                             Else Contenu:='[ ]' ;
  691. End ;
  692.  
  693. Procedure TChampBooleen.EcritResultat ;
  694. Type PBoolean  = ^Boolean ;
  695. Begin
  696.      PBoolean(Variable)^:=Contenu[2]<>' ' ;
  697. End ;
  698.  
  699. End.
  700.  
  701. { ---------------------    DEMO ----------------------------}
  702. { Example for the SAISIE unit. Raphaël Vanney, 07/94 }
  703.  
  704. {$d+,l+,x+}
  705.  
  706. Uses CRT,
  707.      Saisie,
  708.      Strings,
  709.      Objects,
  710.      DOS ;
  711.  
  712. Var  Test      : PGroupeSaisie ;
  713.  
  714.      Enreg     :
  715.      Record
  716.           LastName       : String[30] ;
  717.           FirstName      : String[30] ;
  718.           Address        : String[100] ;
  719.           ZipCode        : LongInt ;
  720.           City           : String[30] ;
  721.           Sex            : Integer ;
  722.      End ;
  723.      Liste     : PListeChaines ;
  724.  
  725. Begin
  726.      ClrScr ;
  727.      TextColor(LightCyan) ;
  728.      TextBackGround(Blue) ;
  729.  
  730.      FillChar(Enreg, SizeOf(Enreg), #0) ;
  731.      TextColor(LightGreen) ;
  732.      GoToXY(1, 1) ;
  733.      Write('^Enter to validate') ;
  734.  
  735.      Liste:=New(PListeChaines, Init(2, 2)) ;
  736.      Liste^.Insert(NewStr('Unknown')) ;
  737.      Liste^.Insert(NewStr('Male')) ;
  738.      Liste^.Insert(NewStr('Female')) ;
  739.  
  740.      Test:=New(PGroupeSaisie, Init(2, 2)) ;
  741.      With Enreg Do
  742.      Begin
  743.           GoToXY(1, 10) ; Write('Last name : ') ;
  744.           Test^.Insert(New(PChampMajuscules, Init(12, 10,
  745.                                                   20,
  746.                                                   SizeOf(LastName)-1,
  747.                                                   (Blue ShL 4)+White,
  748.                                                   (Blue ShL 4)+LightGray,
  749.                                                   LastName))) ;
  750.           GoToXY(1, 11) ; Write('FirstName : ') ;
  751.           Test^.Insert(New(PChampSaisie, Init(12, 11,
  752.                                              20,
  753.                                              SizeOf(FirstName)-1,
  754.                                              (Blue ShL 4)+White,
  755.                                              (Blue ShL 4)+LightGray,
  756.                                              FirstName))) ;
  757.           GoToXY(1, 12) ; Write('Address   : ') ;
  758.           Test^.Insert(New(PChampSaisie, Init(12, 12,
  759.                                              20,
  760.                                              SizeOf(Address)-1,
  761.                                              (Blue ShL 4)+White,
  762.                                              (Blue ShL 4)+LightGray,
  763.                                              Address))) ;
  764.           GoToXY(1, 13) ; Write('Zip code  : ') ;
  765.           Test^.Insert(New(PChampLongInt, Init(   12, 13,
  766.                                                   6,
  767.                                                   5,
  768.                                                   (Blue ShL 4)+White,
  769.                                                   (Blue ShL 4)+LightGray,
  770.                                                   ZipCode))) ;
  771.           GoToXY(1, 14) ; Write('City      : ') ;
  772.           Test^.Insert(New(PChampMajuscules, Init(12, 14,
  773.                                                   20,
  774.                                                   SizeOf(City)-1,
  775.                                                   (Blue ShL 4)+White,
  776.                                                   (Blue ShL 4)+LightGray,
  777.                                                   City))) ;
  778.           GoToXY(1, 15) ; Write('Sex       : ') ;
  779.           Test^.Insert(New(PChampChoixListe, Init(12, 15,
  780.                                                   20,
  781.                                                   (Blue ShL 4)+White,
  782.                                                   (Blue ShL 4)+LightGray,
  783.                                                   Liste,
  784.                                                   Sex))) ;
  785.      End ;
  786.  
  787.      Test^.Execute ;
  788.      Dispose(Liste, Done) ;
  789.      Dispose(Test, Done) ;
  790.  
  791.      GoToXY(1, 18) ;
  792.      TextAttr:=LightGray ;
  793.      With Enreg Do
  794.      Begin
  795.           WriteLn('LastName        =', LastName) ;
  796.           WriteLn('FirstName       =', FirstName) ;
  797.           WriteLn('Address         =', Address) ;
  798.           WriteLn('ZipCode         =', ZipCode) ;
  799.           WriteLn('City            =', City) ;
  800.           WriteLn('Sex             =', Sex) ;
  801.      End ;
  802. End.
  803.